COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	FEXPR COMPL FILE ← BEGIN SCALAR Z
C00007 ENDMK
C⊗;
FEXPR COMPL FILE ← BEGIN SCALAR Z;
	EVAL('OUTPUT . ('DSK: . LIST (CAR FILE . 'LAP)))$
	EVAL('INPUT . ('DSK: . FILE))$
	INC('T ,NIL)$
	OUTC(T,NIL)$
LOOP:	Z ← ERRSET(READ())$
	IF ATOM Z THEN GO TO DONE$
	Z ← CAR Z$
	IF CAR Z EQ 'DE THEN
BEGIN SCALAR PROG;
	PROG ← COMP(CADR Z,CADDR Z,CADDDR Z)$
	MAPC(FUNCTION(PRINT),PROG)$
	OUTC(NIL,NIL)$
	PRINT LIST(CADR Z,LENGTH PROG)$
	OUTC(T,NIL)$
END
	ELSE PRINT Z$
	GO TO LOOP$
DONE:	OUTC(NIL,T)$
	INC(NIL,T)$
	RETURN 'ENDCOMP END;

COMP(FN,VARS,EXP) ←
	(LAMBDA N;
		APPEND(
			LIST LIST('LAP,FN,'SUBR ),
			MKPUSH(N,1),
			COMPEXP(EXP,-N,PRUP(VARS,1)),
			LIST LIST ('SUB ,'P ,LIST('C ,0,0,N,N)),
			'((POPJ P) NIL)))
	LENGTH VARS;

PRUP(VARS,N) ← IF NULL VARS THEN NIL
		ELSE (CAR VARS . N) . PRUP(CDR VARS,N+1);

MKPUSH(N,M) ← IF N<M THEN NIL ELSE LIST('PUSH ,'P ,M).MKPUSH(N,M+1);

COMPEXP(EXP,M,VPR) ←
	IF NULL EXP THEN '((MOVEI 1 0))
	ELSE IF EXP EQ 'T THEN '((MOVEI 1 (QUOTE T)))
	ELSE IF ATOM EXP THEN
		LIST LIST('MOVE ,1,M+CDR ASSOC(EXP,VPR),'P )
	ELSE IF CAR EXP EQ 'AND OR CAR EXP EQ 'OR OR
			CAR EXP EQ 'NOT THEN
		(LAMBDA L1,L2; APPEND(COMBOOL(EXP,M,L1,NIL,VPR),
			LIST('(MOVEI 1 (QUOTE T)),LIST('JRST ,0,L2),
			L1,'(MOVEI 1 0),L2)))
		(GENSYM(),GENSYM())
	ELSE IF CAR EXP EQ 'COND THEN 
		COMCOND(CDR EXP,M,GENSYM(),VPR)
	ELSE IF CAR EXP EQ 'QUOTE THEN LIST LIST('MOVEI,1,EXP)
	ELSE IF ATOM CAR EXP THEN
		(LAMBDA N; APPEND(COMPLIS(CDR EXP,M,VPR),
			LOADAC(1-N,1),
			LIST LIST('SUB ,'P ,LIST('C ,0,0,N,N)),
				LIST LIST('CALL ,N,
				LIST('E ,CAR EXP))))
			LENGTH CDR EXP
	ELSE IF CAAR EXP EQ 'LAMBDA THEN
		(LAMBDA N; APPEND(COMPLIS(CDR EXP,M,VPR),
			COMPEXP(CADDAR EXP,M-N,
			APPEND(PRUP(CADAR EXP,1-M),VPR)),
			LIST LIST('SUB ,'P ,LIST('C ,0,0,N,N))))
		LENGTH CDR EXP;

COMPLIS(U,M,VPR) ←
	IF NULL U THEN NIL
	ELSE APPEND(COMPEXP(CAR U,M,VPR),
		'((PUSH P 1)),
			COMPLIS(CDR U,M-1,VPR));

LOADAC(N,K) ← IF N>0 THEN NIL ELSE LIST('MOVE ,K,N,'P ).
			LOADAC(N+1,K+1);

COMCOND(U,M,L,VPR) ←
	IF NULL U THEN LIST L
	ELSE (LAMBDA L1; APPEND(
		COMBOOL(CAAR U,M,L1,NIL,VPR),
		COMPEXP(CADAR U,M,VPR),
		LIST(LIST('JRST ,L),L1),
		COMCOND(CDR U,M,L,VPR)))
	GENSYM();

COMBOOL(P,M,L,FLG,VPR) ←
	IF ATOM P THEN APPEND(COMPEXP(P,M,VPR),
			LIST LIST(IF FLG THEN 'JUMPN
				ELSE 'JUMPE ,1,L))

	ELSE IF CAR P EQ 'AND THEN
		(IF NOT FLG THEN COMPANDOR(CDR P,M,L,NIL,VPR)
		ELSE (LAMBDA L1; APPEND(
			COMPANDOR(CDR P,M,L1,NIL,VPR),
				LIST LIST('JRST ,0,L),
				LIST L1))
			GENSYM())
	ELSE IF CAR P EQ 'OR THEN
		(IF FLG THEN COMPANDOR(CDR P,M,L,T,VPR)
		ELSE (LAMBDA L1; APPEND(
				COMPANDOR(CDR P,M,L1,T,VPR),
				LIST LIST('JRST ,0,L),
				LIST L1))
			GENSYM())
	ELSE IF CAR P EQ 'NOT THEN
		COMBOOL(CADR P,M,L,NOT FLG,VPR)
	ELSE APPEND(COMPEXP(P,M,VPR),
			LIST LIST(IF FLG THEN 'JUMPN
				ELSE 'JUMPE ,1,L));

COMPANDOR(U,M,L,FLG,VPR) ← IF NULL U THEN NIL
	ELSE APPEND(COMBOOL(CAR U,M,L,FLG,VPR),
			COMPANDOR(CDR U,M,L,FLG,VPR));